//----------------------------------------------------------------------------
//
// Copyright (c) 2002-2012 Microsoft Corporation. 
//
// This source code is subject to terms and conditions of the Apache License, Version 2.0. A 
// copy of the license can be found in the License.html file at the root of this distribution. 
// By using this source code in any fashion, you are agreeing to be bound 
// by the terms of the Apache License, Version 2.0.
//
// You must not remove this notice, or any other, from this software.
//----------------------------------------------------------------------------

///  Generate the hash/compare functions we add to user-defined types by default.
module internal Microsoft.FSharp.Compiler.Augment 
open Internal.Utilities
open Microsoft.FSharp.Compiler 
open Microsoft.FSharp.Compiler.AbstractIL 
open Microsoft.FSharp.Compiler.AbstractIL.IL
open Microsoft.FSharp.Compiler.AbstractIL.Internal 
open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library
open Microsoft.FSharp.Compiler.Tast
open Microsoft.FSharp.Compiler.Tastops
open Microsoft.FSharp.Compiler.Ast
open Microsoft.FSharp.Compiler.ErrorLogger
open Microsoft.FSharp.Compiler.PrettyNaming
open Microsoft.FSharp.Compiler.Lib
open Microsoft.FSharp.Compiler.Env
open Microsoft.FSharp.Compiler.Infos

let mkIComparableCompareToSlotSig g = 
    TSlotSig("CompareTo",g.mk_IComparable_ty, [],[], [[TSlotParam(Some("obj"),g.obj_ty,false,false,false,[])]],Some g.int_ty)
    
let mkGenericIComparableCompareToSlotSig g typ =
    TSlotSig("CompareTo",(mkAppTy g.system_GenericIComparable_tcref [typ]),[],[], [[TSlotParam(Some("obj"),typ,false,false,false,[])]],Some g.int_ty)
    
let mkIStructuralComparableCompareToSlotSig g =
    TSlotSig("CompareTo",g.mk_IStructuralComparable_ty,[],[],[[TSlotParam(None,(mkTupleTy [g.obj_ty ; g.mk_IComparer_ty]),false,false,false,[])]], Some g.int_ty)
    
let mkGenericIEquatableEqualsSlotSig g typ =
    TSlotSig("Equals",(mkAppTy g.system_GenericIEquatable_tcref [typ]),[],[], [[TSlotParam(Some("obj"),typ,false,false,false,[])]],Some g.bool_ty)
    
let mkIStructuralEquatableEqualsSlotSig g =
    TSlotSig("Equals",g.mk_IStructuralEquatable_ty,[],[],[[TSlotParam(None,(mkTupleTy [g.obj_ty ; g.mk_IEqualityComparer_ty]),false,false,false,[])]], Some g.bool_ty)

let mkIStructuralEquatableGetHashCodeSlotSig g =
    TSlotSig("GetHashCode",g.mk_IStructuralEquatable_ty,[],[],[[TSlotParam(None,g.mk_IEqualityComparer_ty,false,false,false,[])]], Some g.int_ty)
 
let mkGetHashCodeSlotSig g = 
    TSlotSig("GetHashCode", g.obj_ty, [],[], [[]],Some  g.int_ty)

let mkEqualsSlotSig g = 
    TSlotSig("Equals", g.obj_ty, [],[], [[TSlotParam(Some("obj"),g.obj_ty,false,false,false,[])]],Some  g.bool_ty)


let mkILObjectGetTypeMethSpec ilg = IL.mkILNonGenericInstanceMethSpecInTy(ilg.typ_Object,"GetType",[],ilg.typ_Type)
let mkILObjectToStringMethSpec ilg = IL.mkILNonGenericInstanceMethSpecInTy(ilg.typ_Object,"ToString",[],ilg.typ_String)


//-------------------------------------------------------------------------
// Helpers associated with code-generation of comparison/hash augmentations
//------------------------------------------------------------------------- 

let mkThisTy  g ty = if isStructTy g ty then mkByrefTy g ty else ty 

let mkCompareObjTy          g ty = (mkThisTy g ty) --> (g.obj_ty --> g.int_ty)
let mkCompareTy             g ty = (mkThisTy g ty) --> (ty --> g.int_ty)
let mkCompareWithComparerTy g ty = (mkThisTy g ty) --> ((mkTupleTy [g.obj_ty ; g.mk_IComparer_ty]) --> g.int_ty)

let mkEqualsObjTy          g ty = (mkThisTy g ty) --> (g.obj_ty --> g.bool_ty)
let mkEqualsTy             g ty = (mkThisTy g ty) --> (ty --> g.bool_ty)
let mkEqualsWithComparerTy g ty = (mkThisTy g ty) --> ((mkTupleTy [g.obj_ty ; g.mk_IEqualityComparer_ty]) --> g.bool_ty)

let mkHashTy             g ty = (mkThisTy g ty) --> (g.unit_ty --> g.int_ty)
let mkHashWithComparerTy g ty = (mkThisTy g ty) --> (g.mk_IEqualityComparer_ty --> g.int_ty)

//-------------------------------------------------------------------------
// Polymorphic comparison
//------------------------------------------------------------------------- 

let mkRelBinOp g op m e1 e2 = mkAsmExpr ([ op  ],[],  [e1; e2],[g.bool_ty],m)
let mkClt g m e1 e2 = mkRelBinOp g IL.AI_clt m e1 e2 
let mkCgt g m e1 e2 = mkRelBinOp g IL.AI_cgt m e1 e2

//-------------------------------------------------------------------------
// REVIEW: make this a .constrained call, not a virtual call.
//------------------------------------------------------------------------- 

// for creating and using GenericComparer objects and for creating and using 
// IStructuralComparable objects (Eg, Calling CompareTo(obj o, IComparer comp))

let mkILLangPrimTy g = mkILNonGenericBoxedTy g.tcref_LanguagePrimitives.CompiledRepresentationForNamedType

let mkILCallGetComparer g m = 
    let ty = mkILNonGenericBoxedTy g.tcref_System_Collections_IComparer.CompiledRepresentationForNamedType
    let mspec = mkILNonGenericStaticMethSpecInTy (mkILLangPrimTy g, "get_GenericComparer",[],ty)
    mkAsmExpr([IL.mkNormalCall mspec], [], [], [g.mk_IComparer_ty], m)

let mkILCallGetEqualityComparer g m = 
    let ty = mkILNonGenericBoxedTy g.tcref_System_Collections_IEqualityComparer.CompiledRepresentationForNamedType
    let mspec = mkILNonGenericStaticMethSpecInTy (mkILLangPrimTy g,"get_GenericEqualityComparer",[],ty)
    mkAsmExpr([IL.mkNormalCall mspec], [], [], [g.mk_IEqualityComparer_ty], m)

let mkThisVar g m ty = mkCompGenLocal m "this" (mkThisTy g ty)  

let mkShl g m acce n = mkAsmExpr([ IL.AI_shl ],[],[acce; mkInt g m n],[g.int_ty],m)
let mkShr g m acce n = mkAsmExpr([ IL.AI_shr ],[],[acce; mkInt g m n],[g.int_ty],m)
let mkAdd g m e1 e2 = mkAsmExpr([ IL.AI_add ],[],[e1;e2],[g.int_ty],m)
                   
let mkAddToHashAcc g m e accv acce =
    mkValSet m accv (mkAdd g m (mkInt g m 0x9e3779b9) 
                          (mkAdd g m e 
                             (mkAdd g m (mkShl g m acce 6) (mkShr g m acce 2))))

     
let mkCombineHashGenerators g m exprs accv acce =
    (acce,exprs) ||> List.fold (fun tm e -> mkCompGenSequential m (mkAddToHashAcc g m e accv acce) tm)

//-------------------------------------------------------------------------
// Build comparison functions for union, record and exception types.
//------------------------------------------------------------------------- 

let mkThisVarThatVar g m ty =
    let thisv,thise = mkThisVar g m ty
    let thatv,thate = mkCompGenLocal m "obj" (mkThisTy g ty)   
    thisv,thatv,thise,thate

let mkThatVarBind g m ty thatv expr = 
    if isStructTy g ty then 
      let thatv2,_ = mkMutableCompGenLocal m "obj" ty 
      thatv2,mkCompGenLet m thatv (mkValAddr m (mkLocalValRef thatv2)) expr
    else thatv,expr 

let mkThatAddrLocal g m ty =
    if isStructTy g ty then
        mkMutableCompGenLocal m "objCast" (mkByrefTy g ty)     
    else
        mkCompGenLocal m "objCast" ty
        
let mkBindThatAddr g m ty thataddrv thatv thate expr =
    if isStructTy g ty then
        mkCompGenLet m thataddrv (mkValAddr m (mkLocalValRef thatv))  expr
    else
        mkCompGenLet m thataddrv thate expr

let mkCompareTestConjuncts g m exprs =
    match exprs with 
    | [] -> mkZero g m
    | [h] -> h
    | l -> 
        let a,b = List.frontAndBack l 
        (a,b) ||> List.foldBack (fun e acc -> 
            let nv,ne = mkCompGenLocal m "n" g.int_ty
            mkCompGenLet m nv e
              (mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.int_ty
                 (mkClt g m ne (mkZero g m))
                 ne
                 (mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.int_ty 
                    (mkCgt g m ne (mkZero g m))
                    ne
                    acc)))

let mkEqualsTestConjuncts g m exprs =
    match exprs with 
    | [] -> mkOne g m
    | [h] -> h
    | l -> 
        let a,b = List.frontAndBack l 
        List.foldBack (fun e acc -> mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.bool_ty e acc (mkFalse g m)) a b

let mkMinimalTy g (tcref:TyconRef) = 
    if tcref.Deref.IsExceptionDecl then [], g.exn_ty 
    else generalizeTyconRef tcref

// check for nulls
let mkBindNullComparison g m thise thate expr = 
    let expr = mkNonNullCond g m g.int_ty thate expr (mkOne g m) 
    let expr = mkNonNullCond g m g.int_ty thise expr (mkNonNullCond g m g.int_ty thate (mkMinusOne g m) (mkZero g m) )
    expr

let mkBindThisNullEquals g m thise thate expr = 
    let expr = mkNonNullCond g m g.bool_ty thise expr (mkNonNullCond g m g.int_ty thate (mkFalse g m) (mkTrue g m) )
    expr

let mkBindThatNullEquals g m thise thate expr = 
    let expr = mkNonNullCond g m g.bool_ty thate expr (mkFalse g m) 
    let expr = mkBindThisNullEquals g m thise thate expr
    expr
    
let mkBindNullHash g m thise expr = 
    let expr = mkNonNullCond g m g.int_ty thise expr (mkZero g m)
    expr

/// Build the comparison implementation for a record type 
let mkRecdCompare g tcref (tycon:Tycon) = 
    let m = tycon.Range 
    let fields = tycon.AllInstanceFieldsAsList 
    let tinst,ty = mkMinimalTy g tcref
    let thisv,thatv,thise,thate = mkThisVarThatVar g m ty 
    let compe = mkILCallGetComparer g m
    let mkTest (fspec:RecdField) = 
        let fty = fspec.FormalType 
        let fref = mkNestedRecdFieldRef tcref fspec 
        let m = fref.Range 
        mkCallGenericComparisonWithComparerOuter g m fty
          compe
          (mkRecdFieldGetViaExprAddr(thise, fref, tinst, m))
          (mkRecdFieldGetViaExprAddr(thate, fref, tinst, m)) 
    let expr = mkCompareTestConjuncts g m (List.map mkTest fields) 

    let expr = if tycon.IsStructOrEnumTycon then expr else mkBindNullComparison g m thise thate expr

    let thatv,expr = mkThatVarBind g m ty thatv expr
    thisv,thatv, expr


/// Build the comparison implementation for a record type when parameterized by a comparer
let mkRecdCompareWithComparer g tcref (tycon:Tycon) (_thisv,thise) (_,thate) compe = 
    let m = tycon.Range 
    let fields = tycon.AllInstanceFieldsAsList
    let tinst,ty = mkMinimalTy g tcref
    let tcv,tce = mkCompGenLocal m "objTemp" ty    // let tcv = thate
    let thataddrv,thataddre = mkThatAddrLocal g m ty      // let thataddrv = &tcv, if a struct
    
    let mkTest (fspec:RecdField) = 
        let fty = fspec.FormalType 
        let fref = mkNestedRecdFieldRef tcref fspec 
        let m = fref.Range 
        mkCallGenericComparisonWithComparerOuter g m fty
          compe
          (mkRecdFieldGetViaExprAddr(thise, fref, tinst, m))
          (mkRecdFieldGetViaExprAddr(thataddre, fref, tinst, m))
    let expr = mkCompareTestConjuncts g m (List.map mkTest fields) 

    let expr = if tycon.IsStructOrEnumTycon then expr else mkBindNullComparison g m thise thate expr

    let expr = mkBindThatAddr g m ty thataddrv tcv tce expr
    // will be optimized away if not necessary
    let expr = mkCompGenLet m tcv thate expr
    expr    


/// Build the equality implementation wrapper for a record type 
let mkRecdEquality g tcref (tycon:Tycon) = 
    let m = tycon.Range
    let fields = tycon.AllInstanceFieldsAsList 
    let tinst,ty = mkMinimalTy g tcref
    let thisv,thatv,thise,thate = mkThisVarThatVar g m ty 
    let mkTest (fspec:RecdField) = 
        let fty = fspec.FormalType 
        let fref = mkNestedRecdFieldRef tcref fspec 
        let m = fref.Range 
        mkCallGenericEqualityEROuter g m fty
          (mkRecdFieldGetViaExprAddr(thise, fref, tinst, m))
          (mkRecdFieldGetViaExprAddr(thate, fref, tinst, m)) 
    let expr = mkEqualsTestConjuncts g m (List.map mkTest fields) 

    let expr = if tycon.IsStructOrEnumTycon then expr else mkBindThatNullEquals g m thise thate expr

    let thatv,expr = mkThatVarBind g m ty thatv expr
    thisv,thatv,expr
    
/// Build the equality implementation for a record type when parameterized by a comparer
let mkRecdEqualityWithComparer g tcref (tycon:Tycon) (_thisv,thise) thatobje (thatv,thate) compe =
    let m = tycon.Range
    let fields = tycon.AllInstanceFieldsAsList
    let tinst,ty = mkMinimalTy g tcref
    let thataddrv,thataddre = mkThatAddrLocal g m ty
    
    let mkTest (fspec:RecdField) =
        let fty = fspec.FormalType
        let fref = mkNestedRecdFieldRef tcref fspec
        let m = fref.Range
        
        mkCallGenericEqualityWithComparerOuter g m fty
            compe
            (mkRecdFieldGetViaExprAddr(thise, fref, tinst, m))
            (mkRecdFieldGetViaExprAddr(thataddre, fref, tinst, m))
    let expr = mkEqualsTestConjuncts g m (List.map mkTest fields)

    let expr = mkBindThatAddr g m ty thataddrv thatv thate expr
    // will be optimized away if not necessary
    let expr = mkIsInstConditional g m ty thatobje thatv expr (mkFalse g m)
    let expr = if tycon.IsStructOrEnumTycon then expr else mkBindThisNullEquals g m thise thatobje expr

    expr
        
/// Build the equality implementation for an exception definition
let mkExnEquality g exnref (exnc:Tycon) = 
    let m = exnc.Range 
    let thatv,thate = mkCompGenLocal m "obj" g.exn_ty  
    let thisv,thise = mkThisVar g m g.exn_ty  
    let mkTest i (rfield:RecdField) = 
        let fty = rfield.FormalType
        mkCallGenericEqualityEROuter g m fty
          (mkExnCaseFieldGet(thise, exnref, i, m))
          (mkExnCaseFieldGet(thate, exnref, i, m)) 
    let expr = mkEqualsTestConjuncts g m (List.mapi mkTest (exnc.AllInstanceFieldsAsList)) 
    let expr =
        let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) 
        let dtree = 
          TDSwitch(thate,
                   [ mkCase(Test.IsInst(g.exn_ty,mkAppTy exnref []),
                            mbuilder.AddResultTarget(expr,SuppressSequencePointAtTarget)) ],
                   Some(mbuilder.AddResultTarget(mkFalse g m,SuppressSequencePointAtTarget)),
                   m)
        mbuilder.Close(dtree,m,g.bool_ty)

    let expr = mkBindThatNullEquals g m thise thate expr
    thisv,thatv, expr
    
    
/// Build the equality implementation for an exception definition when parameterized by a comparer
let mkExnEqualityWithComparer g exnref (exnc:Tycon) (_thisv,thise) thatobje (thatv,thate) compe = 
    let m = exnc.Range
    let thataddrv,thataddre =  mkThatAddrLocal g m g.exn_ty
    let mkTest i (rfield:RecdField) = 
        let fty = rfield.FormalType
        mkCallGenericEqualityWithComparerOuter g m fty
          compe
          (mkExnCaseFieldGet(thise, exnref, i, m))
          (mkExnCaseFieldGet(thataddre, exnref, i, m))
    let expr = mkEqualsTestConjuncts g m (List.mapi mkTest (exnc.AllInstanceFieldsAsList)) 
    let expr =
        let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) 
        let dtree = 
          TDSwitch(thataddre,
                   [ mkCase(Test.IsInst(g.exn_ty,mkAppTy exnref []),
                            mbuilder.AddResultTarget(expr,SuppressSequencePointAtTarget)) ],
                   Some(mbuilder.AddResultTarget(mkFalse g m,SuppressSequencePointAtTarget)),
                   m)
        mbuilder.Close(dtree,m,g.bool_ty)
    let expr = mkBindThatAddr g m g.exn_ty thataddrv thatv thate expr
    let expr = mkIsInstConditional g m g.exn_ty thatobje thatv expr (mkFalse g m)
    let expr = if exnc.IsStructOrEnumTycon then expr else mkBindThisNullEquals g m thise thatobje expr
    expr

/// Build the comparison implementation for a union type
let mkUnionCompare g tcref (tycon:Tycon) = 
    let m = tycon.Range 
    let ucases = tycon.UnionCasesAsList 
    let tinst,ty = mkMinimalTy g tcref
    let thisv,thise = mkCompGenLocal m "this" ty  
    let thatv,thate = mkCompGenLocal m "obj" ty  
    let thistagv,thistage = mkCompGenLocal m "thisTag" g.int_ty  
    let thattagv,thattage = mkCompGenLocal m "thatTag" g.int_ty 
    let compe = mkILCallGetComparer g m

    let expr = 
        let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) 
        let mkCase ucase =
            let cref = mkNestedUnionCaseRef tcref ucase 
            let m = cref.Range 
            let thisucv,thisucve = mkCompGenLocal m "thisCast" (mkProvenUnionCaseTy cref tinst)
            let thatucv,thatucve = mkCompGenLocal m "objCast" (mkProvenUnionCaseTy cref tinst)
            let mkTest j (argty:RecdField) = 
              mkCallGenericComparisonWithComparerOuter g m argty.FormalType
                compe
                (mkUnionCaseFieldGetProven(thisucve, cref, tinst, j, m))
                (mkUnionCaseFieldGetProven(thatucve, cref, tinst, j, m)) 
            let rfields = ucase.RecdFields 
            if isNil rfields then None else
            Some (mkCase(Test.UnionCase(cref,tinst),
                          mbuilder.AddResultTarget
                             (mkCompGenLet m thisucv (mkUnionCaseProof(thise,cref,tinst,m))
                                 (mkCompGenLet m thatucv (mkUnionCaseProof(thate,cref,tinst,m))
                                     (mkCompareTestConjuncts g m (List.mapi mkTest rfields))),
                              SuppressSequencePointAtTarget)))
        
        let nullary,nonNullary = List.partition isNone (List.map mkCase ucases)  
        if isNil nonNullary then mkZero g m else 
        let dtree = 
            TDSwitch(thise,
                     (nonNullary |> List.map (function (Some c) -> c | None -> failwith "mkUnionCompare")), 
                     (if isNil nullary then None 
                      else Some (mbuilder.AddResultTarget(mkZero g m,SuppressSequencePointAtTarget))),
                     m) 
        mbuilder.Close(dtree,m,g.int_ty)

    let expr = 
        if ucases.Length = 1 then expr else
        let tagsEqTested = 
            mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.int_ty  
              (mkILAsmCeq g m thistage thattage)
              expr
              (mkAsmExpr ([ IL.AI_sub  ],[],  [thistage; thattage],[g.int_ty],m))in 
        mkCompGenLet m thistagv
          (mkUnionCaseTagGet (thise,tcref,tinst,m))
          (mkCompGenLet m thattagv
               (mkUnionCaseTagGet (thate,tcref,tinst,m))
               tagsEqTested) 

    let expr = mkBindNullComparison g m thise thate expr
    thisv,thatv, expr


/// Build the comparison implementation for a union type when parameterized by a comparer
let mkUnionCompareWithComparer g tcref (tycon:Tycon) (_thisv,thise) (thatv,thate) compe = 
    let m = tycon.Range 
    let ucases = tycon.UnionCasesAsList
    let tinst,ty = mkMinimalTy g tcref
    let thistagv,thistage = mkCompGenLocal m "thisTag" g.int_ty  
    let thattagv,thattage = mkCompGenLocal m "thatTag" g.int_ty  
    let thataddrv,thataddre = mkThatAddrLocal g m ty

    let expr = 
        let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) 
        let mkCase ucase =
            let cref = mkNestedUnionCaseRef tcref ucase 
            let m = cref.Range 
            let thisucv,thisucve = mkCompGenLocal m "thisCastu" (mkProvenUnionCaseTy cref tinst)
            let thatucv,thatucve = mkCompGenLocal m "thatCastu" (mkProvenUnionCaseTy cref tinst)
            let mkTest j (argty:RecdField) = 
              mkCallGenericComparisonWithComparerOuter g m argty.FormalType
                compe
                (mkUnionCaseFieldGetProven(thisucve, cref, tinst, j, m))
                (mkUnionCaseFieldGetProven(thatucve, cref, tinst, j, m))
            let rfields = ucase.RecdFields 
            if isNil rfields then None else
            Some (mkCase(Test.UnionCase(cref,tinst),
                          mbuilder.AddResultTarget
                             (mkCompGenLet m thisucv (mkUnionCaseProof(thise,cref,tinst,m))
                                 (mkCompGenLet m thatucv (mkUnionCaseProof(thataddre,cref,tinst,m))
                                     (mkCompareTestConjuncts g m (List.mapi mkTest rfields))),
                              SuppressSequencePointAtTarget)))
        
        let nullary,nonNullary = List.partition isNone (List.map mkCase ucases)  
        if isNil nonNullary then mkZero g m else 
        let dtree = 
            TDSwitch(thise,
                     (nonNullary |> List.map (function (Some c) -> c | None -> failwith "mkUnionCompare")), 
                     (if isNil nullary then None 
                      else Some (mbuilder.AddResultTarget(mkZero g m,SuppressSequencePointAtTarget))),
                     m) 
        mbuilder.Close(dtree,m,g.int_ty)

    let expr = 
        if ucases.Length = 1 then expr else
        let tagsEqTested = 
            mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.int_ty  
              (mkILAsmCeq g m thistage thattage)
              expr
              (mkAsmExpr ([ IL.AI_sub  ],[],  [thistage; thattage],[g.int_ty],m))in 
        mkCompGenLet m thistagv
          (mkUnionCaseTagGet (thise,tcref,tinst,m))
          (mkCompGenLet m thattagv
               (mkUnionCaseTagGet (thataddre,tcref,tinst,m))
               tagsEqTested) 

    let expr = mkBindNullComparison g m thise thate expr
    let expr = mkBindThatAddr g m ty thataddrv thatv thate expr
    expr
    
    
/// Build the equality implementation for a union type
let mkUnionEquality g tcref (tycon:Tycon) = 
    let m = tycon.Range 
    let ucases = tycon.UnionCasesAsList 
    let tinst,ty = mkMinimalTy g tcref
    let thisv,thise = mkCompGenLocal m "this" ty  
    let thatv,thate = mkCompGenLocal m "obj" ty  
    let thistagv,thistage = mkCompGenLocal m "thisTag" g.int_ty  
    let thattagv,thattage = mkCompGenLocal m "thatTag" g.int_ty  

    let expr = 
        let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) 
        let mkCase ucase =
            let cref = mkNestedUnionCaseRef tcref ucase 
            let m = cref.Range 
            let thisucv,thisucve = mkCompGenLocal m "thisCast" (mkProvenUnionCaseTy cref tinst)
            let thatucv,thatucve = mkCompGenLocal m "objCast" (mkProvenUnionCaseTy cref tinst)
            let mkTest j (argty:RecdField) = 
                mkCallGenericEqualityEROuter g m argty.FormalType
                  (mkUnionCaseFieldGetProven(thisucve, cref, tinst, j, m))
                  (mkUnionCaseFieldGetProven(thatucve, cref, tinst, j, m)) 
            let rfields = ucase.RecdFields
            if isNil rfields then None else
            Some (mkCase(Test.UnionCase(cref,tinst),
                          mbuilder.AddResultTarget
                              (mkCompGenLet m thisucv (mkUnionCaseProof(thise,cref,tinst,m))
                                 (mkCompGenLet m thatucv (mkUnionCaseProof(thate,cref,tinst,m))
                                     (mkEqualsTestConjuncts g m (List.mapi mkTest rfields))),
                               SuppressSequencePointAtTarget)))
        
        let nullary,nonNullary = List.partition isNone (List.map mkCase ucases)  
        if isNil nonNullary then mkTrue g m else 
        let dtree = 
            TDSwitch(thise,List.map (function (Some c) -> c | None -> failwith "mkUnionEquality") nonNullary, 
                    (if isNil nullary then None else Some (mbuilder.AddResultTarget(mkTrue g m,SuppressSequencePointAtTarget))),
                    m) 
        mbuilder.Close(dtree,m,g.bool_ty)
        
    let expr = 
        if ucases.Length = 1 then expr else
        let tagsEqTested = 
          mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.bool_ty  
            (mkILAsmCeq g m thistage thattage)
            expr
            (mkFalse g m)

        mkCompGenLet m thistagv
          (mkUnionCaseTagGet (thise,tcref,tinst,m))
          (mkCompGenLet m thattagv
               (mkUnionCaseTagGet (thate,tcref,tinst,m))
               tagsEqTested) 

    let expr = mkBindThatNullEquals g m thise thate expr
    thisv,thatv, expr


/// Build the equality implementation for a union type when parameterized by a comparer
let mkUnionEqualityWithComparer g tcref (tycon:Tycon) (_thisv,thise) thatobje (thatv,thate) compe =
    let m = tycon.Range 
    let ucases = tycon.UnionCasesAsList
    let tinst,ty = mkMinimalTy g tcref
    let thistagv,thistage = mkCompGenLocal m "thisTag" g.int_ty  
    let thattagv,thattage = mkCompGenLocal m "thatTag" g.int_ty  
    let thataddrv,thataddre = mkThatAddrLocal g m ty

    let expr = 
        let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) 
        let mkCase ucase =
            let cref = mkNestedUnionCaseRef tcref ucase 
            let m = cref.Range 
            let thisucv,thisucve = mkCompGenLocal m "thisCastu" (mkProvenUnionCaseTy cref tinst)
            let thatucv,thatucve = mkCompGenLocal m "thatCastu" (mkProvenUnionCaseTy cref tinst)
            let mkTest j (argty:RecdField) = 
              mkCallGenericEqualityWithComparerOuter g m argty.FormalType
                compe
                (mkUnionCaseFieldGetProven(thisucve, cref, tinst, j, m))
                (mkUnionCaseFieldGetProven(thatucve, cref, tinst, j, m))
            let rfields = ucase.RecdFields
            if isNil rfields then None else
            Some (mkCase(Test.UnionCase(cref,tinst),
                          mbuilder.AddResultTarget
                              (mkCompGenLet m thisucv (mkUnionCaseProof(thise,cref,tinst,m))
                                 (mkCompGenLet m thatucv (mkUnionCaseProof(thataddre,cref,tinst,m))
                                     (mkEqualsTestConjuncts g m (List.mapi mkTest rfields))),
                               SuppressSequencePointAtTarget)))
        
        let nullary,nonNullary = List.partition isNone (List.map mkCase ucases)  
        if isNil nonNullary then mkTrue g m else 
        let dtree = 
            TDSwitch(thise,List.map (function (Some c) -> c | None -> failwith "mkUnionEquality") nonNullary, 
                    (if isNil nullary then None else Some (mbuilder.AddResultTarget(mkTrue g m,SuppressSequencePointAtTarget))),
                    m) 
        mbuilder.Close(dtree,m,g.bool_ty)
        
    let expr = 
        if ucases.Length = 1 then expr else
        let tagsEqTested = 
          mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.bool_ty  
            (mkILAsmCeq g m thistage thattage)
            expr
            (mkFalse g m)

        mkCompGenLet m thistagv
          (mkUnionCaseTagGet (thise,tcref,tinst,m))
          (mkCompGenLet m thattagv
               (mkUnionCaseTagGet (thataddre,tcref,tinst,m))
               tagsEqTested) 
    let expr = mkBindThatAddr g m ty thataddrv thatv thate expr
    let expr = mkIsInstConditional g m ty thatobje thatv expr (mkFalse g m)
    let expr = if tycon.IsStructOrEnumTycon then expr else mkBindThisNullEquals g m thise thatobje expr
    expr

//-------------------------------------------------------------------------
// Build hashing functions for union, record and exception types.
// Hashing functions must respect the "=" and comparison operators.
//------------------------------------------------------------------------- 

/// Structural hash implementation for record types when parameterized by a comparer 
let mkRecdHashWithComparer g tcref (tycon:Tycon) compe = 
    let m = tycon.Range 
    let fields = tycon.AllInstanceFieldsAsList
    let tinst,ty = mkMinimalTy g tcref
    let thisv,thise = mkThisVar g m ty
    let mkFieldHash (fspec:RecdField) = 
        let fty = fspec.FormalType
        let fref = mkNestedRecdFieldRef tcref fspec 
        let m = fref.Range 
        let e = mkRecdFieldGetViaExprAddr(thise, fref, tinst, m)
        
        mkCallGenericHashWithComparerOuter g m fty compe e
            
    let accv,acce = mkMutableCompGenLocal m "i" g.int_ty                  
    let stmt = mkCombineHashGenerators g m (List.map mkFieldHash fields) (mkLocalValRef accv) acce
    let expr = mkCompGenLet m accv (mkZero g m) stmt 
    let expr = if tycon.IsStructOrEnumTycon then expr else mkBindNullHash g m thise expr
    thisv,expr

/// Structural hash implementation for exception types when parameterized by a comparer
let mkExnHashWithComparer g exnref (exnc:Tycon) compe = 
    let m = exnc.Range
    let thisv,thise = mkThisVar g m g.exn_ty
    
    let mkHash i (rfield:RecdField) = 
        let fty = rfield.FormalType
        let e = mkExnCaseFieldGet(thise, exnref, i, m)
        
        mkCallGenericHashWithComparerOuter g m fty compe e
       
    let accv,acce = mkMutableCompGenLocal m "i" g.int_ty                  
    let stmt = mkCombineHashGenerators g m (List.mapi mkHash (exnc.AllInstanceFieldsAsList)) (mkLocalValRef accv) acce
    let expr = mkCompGenLet m accv (mkZero g m) stmt 
    let expr = mkBindNullHash g m thise expr
    thisv,expr

/// Structural hash implementation for union types when parameterized by a comparer   
let mkUnionHashWithComparer g tcref (tycon:Tycon) compe =
    let m = tycon.Range
    let ucases = tycon.UnionCasesAsList
    let tinst,ty = mkMinimalTy g tcref
    let thisv,thise = mkThisVar g m ty
    let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) 
    let accv,acce = mkMutableCompGenLocal m "i" g.int_ty                  
    let mkCase i ucase1 = 
      let c1ref = mkNestedUnionCaseRef tcref ucase1 
      let ucv,ucve = mkCompGenLocal m "unionCase" (mkProvenUnionCaseTy c1ref tinst)
      let m = c1ref.Range 
      let mkHash j (rfield:RecdField) =  
        let fty = rfield.FormalType
        let e = mkUnionCaseFieldGetProven(ucve, c1ref, tinst, j, m)
        mkCallGenericHashWithComparerOuter g m fty compe e
      mkCase(Test.UnionCase(c1ref,tinst),
              mbuilder.AddResultTarget 
                (mkCompGenLet m ucv
                    (mkUnionCaseProof(thise,c1ref,tinst,m))
                    (mkCompGenSequential m 
                          (mkValSet m (mkLocalValRef accv) (mkInt g m i)) 
                          (mkCombineHashGenerators g m (List.mapi mkHash ucase1.RecdFields) (mkLocalValRef accv) acce)),
                 SuppressSequencePointAtTarget))
    let dtree = TDSwitch(thise,List.mapi mkCase ucases, None,m) 
    let stmt = mbuilder.Close(dtree,m,g.int_ty)
    let expr = mkCompGenLet m accv (mkZero g m) stmt 
    let expr = mkBindNullHash g m thise expr
    thisv,expr


//-------------------------------------------------------------------------
// The predicate that determines which types implement the 
// pre-baked IStructuralHash and IComparable semantics associated with F#
// types.  Note abstract types are not _known_ to implement these interfaces,
// though the interfaces may be discoverable via type tests.
//------------------------------------------------------------------------- 

let isNominalExnc (exnc:Tycon) = 
    match exnc.ExceptionInfo with 
    | TExnAbbrevRepr _ | TExnNone | TExnAsmRepr _ -> false
    | TExnFresh _ -> true

let isTrueFSharpStructTycon _g (tycon: Tycon) = 
    (tycon.IsFSharpStructOrEnumTycon  && not tycon.IsFSharpEnumTycon)

let canBeAugmentedWithEquals g (tycon:Tycon) = 
    tycon.IsUnionTycon ||
    tycon.IsRecordTycon ||
    (tycon.IsExceptionDecl && isNominalExnc tycon) ||
    isTrueFSharpStructTycon g tycon

let canBeAugmentedWithCompare g (tycon:Tycon) = 
    tycon.IsUnionTycon ||
    tycon.IsRecordTycon ||
    isTrueFSharpStructTycon g tycon

let getAugmentationAttribs g (tycon:Tycon) = 
    canBeAugmentedWithEquals g tycon,
    canBeAugmentedWithCompare g tycon,
    TryFindFSharpBoolAttribute g g.attrib_NoEqualityAttribute tycon.Attribs,
    TryFindFSharpBoolAttribute g g.attrib_CustomEqualityAttribute tycon.Attribs,
    TryFindFSharpBoolAttribute g g.attrib_ReferenceEqualityAttribute tycon.Attribs,
    TryFindFSharpBoolAttribute g g.attrib_StructuralEqualityAttribute tycon.Attribs,
    TryFindFSharpBoolAttribute g g.attrib_NoComparisonAttribute tycon.Attribs,
    TryFindFSharpBoolAttribute g g.attrib_CustomComparisonAttribute tycon.Attribs,
    TryFindFSharpBoolAttribute g g.attrib_StructuralComparisonAttribute tycon.Attribs 

let CheckAugmentationAttribs isImplementation g amap (tycon:Tycon)= 
    let m = tycon.Range
    let attribs = getAugmentationAttribs g tycon
    match attribs with 
    
    // THESE ARE THE LEGITIMATE CASES 

    // [< >] on anything
    | _, _   ,  None    , None, None      ,       None, None      , None     , None

    // [<CustomEquality; CustomComparison>]  on union/record/struct
    | true, _, None, Some(true), None     , None      , None      , Some(true), None

    // [<CustomEquality; NoComparison>]  on union/record/struct
    | true, _, None, Some(true), None     , None      , Some(true), None      , None -> 
        ()

    // [<ReferenceEquality; NoComparison>]  on union/record/struct
    | true, _, None, None     , Some(true), None      , Some(true), None      , None

    // [<ReferenceEquality>] on union/record/struct
    | true, _, None, None     , Some(true), None      , None      , None      , None ->
        if isTrueFSharpStructTycon g tycon then 
            errorR(Error(FSComp.SR.augNoRefEqualsOnStruct(), m))
        else ()

    // [<StructuralEquality; StructuralComparison>]  on union/record/struct
    | true, true, None, None     , None      , Some(true), None      , None      , Some(true) 

    // [<StructuralEquality; NoComparison>] 
    | true, _, None, None      , None     , Some(true), Some(true), None      , None

    // [<StructuralEquality; CustomComparison>] 
    | true, _, None, None      , None     , Some(true), None      , Some(true), None

    // [<NoComparison>] on anything
    | _   , _, None, None      , None     , None      , Some(true), None      , None 

    // [<NoEquality; NoComparison>] on anything
    | _   , _, Some(true), None, None     , None      , Some(true), None      , None ->

        () 

    (* THESE ARE THE ERROR CASES *)

    // [<NoEquality; ...>] 
    | _, _, Some(true), _, _,           _, None, _, _ ->
        errorR(Error(FSComp.SR.augNoEqualityNeedsNoComparison(), m))

    // [<StructuralComparison(_)>] 
    | true, true, _, _, _         , None      , _, _, Some(true) ->
        errorR(Error(FSComp.SR.augStructCompNeedsStructEquality(), m))
    // [<StructuralEquality(_)>] 
    | true, _, _, _, _         , Some(true), None, _, None ->
        errorR(Error(FSComp.SR.augStructEqNeedsNoCompOrStructComp(), m))

    // [<StructuralEquality(_)>] 
    | true, _, _, Some(true), _ , _, None, None, _ ->
        errorR(Error(FSComp.SR.augCustomEqNeedsNoCompOrCustomComp(), m))

    // [<ReferenceEquality; StructuralEquality>] 
    | true, _, _, _, Some(true)  , Some(true)    ,      _, _, _

    // [<ReferenceEquality; StructuralComparison(_) >] 
    | true, _, _, _, Some(true),             _, _, _, Some(true) -> 
        errorR(Error(FSComp.SR.augTypeCantHaveRefEqAndStructAttrs(), m))

    // non augmented type, [<ReferenceEquality; ... >] 
    // non augmented type, [<StructuralEquality; ... >] 
    // non augmented type, [<StructuralComparison(_); ... >] 
    | false,  _, _, _, Some(true), _         , _         , _, _
    | false,  _, _, _, _         , Some(true), _         , _, _ 
    | false,  _, _, _, _         , _         , _         , _, Some(true)  ->
        errorR(Error(FSComp.SR.augOnlyCertainTypesCanHaveAttrs(), m))
    // All other cases
    | _  -> 
        errorR(Error(FSComp.SR.augInvalidAttrs(), m))
    
    let hasNominalInterface tcref =
        let ty = generalizedTyconRef (mkLocalTyconRef tycon)
        ExistsHeadTypeInEntireHierarchy g amap tycon.Range ty tcref

    let hasExplicitICompare = 
        hasNominalInterface g.tcref_System_IStructuralComparable || 
        hasNominalInterface g.tcref_System_IComparable

    let hasExplicitIGenericCompare = 
        hasNominalInterface g.system_GenericIComparable_tcref 

    let hasExplicitEquals = 
        tycon.HasOverride g "Equals" [g.obj_ty] ||
        hasNominalInterface g.tcref_System_IStructuralEquatable

    let hasExplicitGenericEquals = 
        hasNominalInterface g.system_GenericIEquatable_tcref

    match attribs with 
    // [<NoEquality>] + any equality semantics
    | _, _, Some(true), _, _, _, _, _, _ when (hasExplicitEquals || hasExplicitGenericEquals) -> 
        warning(Error(FSComp.SR.augNoEqNeedsNoObjEquals(), m))
    // [<NoComparison>] + any comparison semantics
    | _, _, _, _,         _, _, Some(true), _, _ when (hasExplicitICompare || hasExplicitIGenericCompare) -> 
        warning(Error(FSComp.SR.augNoCompCantImpIComp(), m))

    // [<CustomEquality>] + no explicit override Object.Equals  + no explicit IStructuralEquatable
    | _, _, _, Some(true), _, _, _, _, _ when isImplementation && not hasExplicitEquals && not hasExplicitGenericEquals-> 
        errorR(Error(FSComp.SR.augCustomEqNeedsObjEquals(), m))
    // [<CustomComparison>] + no explicit IComparable + no explicit IStructuralComparable
    | _, _, _, _, _, _, _, Some(true), _ when isImplementation && not hasExplicitICompare && not hasExplicitIGenericCompare -> 
        errorR(Error(FSComp.SR.augCustomCompareNeedsIComp(), m))

    // [<ReferenceEquality>] + any equality semantics
    | _, _, _, _, Some(true), _, _, _, _ when (hasExplicitEquals || hasExplicitIGenericCompare) -> 
        errorR(Error(FSComp.SR.augRefEqCantHaveObjEquals(), m))

    | _ -> 
        ()

let TyconIsCandidateForAugmentationWithCompare g (tycon:Tycon) = 
    // This type gets defined in prim-types, before we can add attributes to F# type definitions
    let isUnit = g.compilingFslib && tycon.DisplayName = "Unit"
    not isUnit && 

    match getAugmentationAttribs g tycon with 
    // [< >] 
    | true, true, None, None, None, None      , None, None, None
    // [<StructuralEquality; StructuralComparison>] 
    | true, true, None, None, None, Some(true), None, None, Some(true) 
    // [<StructuralComparison>] 
    | true, true, None, None, None, None, None, None, Some(true) -> true
    // other cases 
    | _ -> false

let TyconIsCandidateForAugmentationWithEquals g (tycon:Tycon) = 
    // This type gets defined in prim-types, before we can add attributes to F# type definitions
    let isUnit = g.compilingFslib && tycon.DisplayName = "Unit"
    not isUnit && 

    match getAugmentationAttribs g tycon with 
    // [< >] 
    | true, _, None, None, None, None      , _, _, _
    // [<StructuralEquality; _ >] 
    // [<StructuralEquality; StructuralComparison>] 
    | true, _, None, None, None, Some(true), _, _, _ -> true
    // other cases 
    | _ -> false

let TyconIsCandidateForAugmentationWithHash g tycon = TyconIsCandidateForAugmentationWithEquals g tycon
      
//-------------------------------------------------------------------------
// Make values that represent the implementations of the 
// IComparable semantics associated with F# types.  
//------------------------------------------------------------------------- 

let slotImplMethod (final,c,slotsig) = 
  { ImplementedSlotSigs=[slotsig];
    MemberFlags=
        { IsInstance=true; 
          IsDispatchSlot=false;
          IsFinal=final;
          IsOverrideOrExplicitImpl=true;
          MemberKind=MemberKind.Member};
    IsImplemented=false;
    ApparentParent=c} 

let nonVirtualMethod c = 
  { ImplementedSlotSigs=[];
    MemberFlags={ IsInstance=true; 
                  IsDispatchSlot=false;
                  IsFinal=false;
                  IsOverrideOrExplicitImpl=false;
                  MemberKind=MemberKind.Member};
    IsImplemented=false;
    ApparentParent=c} 

let unitArg = ValReprInfo.unitArgData
let unaryArg = [ ValReprInfo.unnamedTopArg ]
let tupArg = [ [ ValReprInfo.unnamedTopArg1; ValReprInfo.unnamedTopArg1 ] ]
let mkValSpec g (tcref:TyconRef) tmty vis  slotsig methn ty argData = 
    let m = tcref.Range 
    let tps = tcref.Typars(m)
    let final = isUnionTy g tmty || isRecdTy g tmty || isStructTy g tmty 
    let membInfo = match slotsig with None -> nonVirtualMethod tcref | Some(slotsig) -> slotImplMethod(final,tcref,slotsig) 
    let inl = ValInline.Optional
    let args = ValReprInfo.unnamedTopArg :: argData
    let topValInfo = Some (ValReprInfo (ValReprInfo.InferTyparInfo tps, args, ValReprInfo.unnamedRetVal)) 
    NewVal (methn, m, None, ty, Immutable, true, topValInfo, vis, ValNotInRecScope, Some(membInfo), NormalVal, [], inl, XmlDoc.Empty, true, false, false, false, false, false, None, Parent(tcref)) 

let MakeValsForCompareAugmentation g (tcref:TyconRef) = 
    let m = tcref.Range
    let _,tmty = mkMinimalTy g tcref
    let tps = tcref.Typars m
    let vis = tcref.TypeReprAccessibility

    mkValSpec g tcref tmty vis  (Some(mkIComparableCompareToSlotSig g)) "CompareTo" (tps +-> (mkCompareObjTy g tmty)) unaryArg, 
    mkValSpec g tcref tmty vis  (Some(mkGenericIComparableCompareToSlotSig g tmty)) "CompareTo" (tps +-> (mkCompareTy g tmty)) unaryArg
    
let MakeValsForCompareWithComparerAugmentation g (tcref:TyconRef) =
    let m = tcref.Range
    let _,tmty = mkMinimalTy g tcref
    let tps = tcref.Typars m
    let vis = tcref.TypeReprAccessibility
    mkValSpec g tcref tmty vis (Some(mkIStructuralComparableCompareToSlotSig g)) "CompareTo" (tps +-> (mkCompareWithComparerTy g tmty)) tupArg

let MakeValsForEqualsAugmentation g (tcref:TyconRef) = 
    let m = tcref.Range
    let _,tmty = mkMinimalTy g tcref
    let vis = tcref.TypeReprAccessibility
    let tps = tcref.Typars m

    let objEqualsVal = mkValSpec g tcref tmty vis  (Some(mkEqualsSlotSig g)) "Equals" (tps +-> (mkEqualsObjTy g tmty)) unaryArg
    let nocEqualsVal = mkValSpec g tcref tmty vis  (if tcref.Deref.IsExceptionDecl then None else Some(mkGenericIEquatableEqualsSlotSig g tmty)) "Equals" (tps +-> (mkEqualsTy g tmty)) unaryArg
    objEqualsVal,nocEqualsVal
    
let MakeValsForEqualityWithComparerAugmentation g (tcref:TyconRef) =
    let _,tmty = mkMinimalTy g tcref
    let vis = tcref.TypeReprAccessibility
    let tps = tcref.Typars(tcref.Range)
    let objGetHashCodeVal = mkValSpec g tcref tmty vis  (Some(mkGetHashCodeSlotSig g)) "GetHashCode" (tps +-> (mkHashTy g tmty)) unitArg
    let withcGetHashCodeVal = mkValSpec g tcref tmty vis (Some(mkIStructuralEquatableGetHashCodeSlotSig g)) "GetHashCode" (tps +-> (mkHashWithComparerTy g tmty)) unaryArg
    let withcEqualsVal  = mkValSpec g tcref tmty vis (Some(mkIStructuralEquatableEqualsSlotSig g)) "Equals" (tps +-> (mkEqualsWithComparerTy g tmty)) tupArg
    objGetHashCodeVal,withcGetHashCodeVal,withcEqualsVal

let MakeBindingsForCompareAugmentation g (tycon:Tycon) = 
    let tcref = mkLocalTyconRef tycon 
    let m = tycon.Range
    let tps = tycon.Typars(tycon.Range)
    let mkCompare comparef =
        match tycon.GeneratedCompareToValues with 
        | None ->  []
        | Some (vref1,vref2) -> 
            let vspec1 = vref1.Deref
            let vspec2 = vref2.Deref
            (* this is the body of the override *)
            let rhs1 = 
              let tinst,ty = mkMinimalTy g tcref
              
              let thisv,thise = mkThisVar g m ty  
              let thatobjv,thatobje = mkCompGenLocal m "obj" g.obj_ty  
              let comparee = 
                  if isUnitTy g ty then mkZero g m else
                  let thate = mkCoerceExpr (thatobje, ty, m, g.obj_ty)

                  mkApps g ((exprForValRef m vref2,vref2.Type), (if isNil tinst then [] else [tinst]), [thise;thate], m)
              
              mkLambdas m tps [thisv;thatobjv] (comparee,g.int_ty)  
            let rhs2 = 
              let thisv,thatv,comparee = comparef g tcref tycon 
              mkLambdas m tps [thisv;thatv] (comparee,g.int_ty)  
            [ // This one must come first because it may be inlined into the second
              mkCompGenBind vspec2 rhs2;
              mkCompGenBind vspec1 rhs1; ] 
    if tycon.IsUnionTycon then mkCompare mkUnionCompare 
    elif tycon.IsRecordTycon || tycon.IsStructOrEnumTycon then mkCompare mkRecdCompare 
    else []
    
let MakeBindingsForCompareWithComparerAugmentation g (tycon:Tycon) =
    let tcref = mkLocalTyconRef tycon
    let m = tycon.Range
    let tps = tycon.Typars(tycon.Range)
    let mkCompare comparef = 
        match tycon.GeneratedCompareToWithComparerValues with
        | None -> []
        | Some (vref) ->
            let vspec = vref.Deref
            let _,ty = mkMinimalTy g tcref

            let compv,compe = mkCompGenLocal m "comp" g.mk_IComparer_ty

            let thisv,thise = mkThisVar g m ty
            let thatobjv,thatobje = mkCompGenLocal m "obj" g.obj_ty
            let thate = mkCoerceExpr (thatobje, ty, m, g.obj_ty)

            let rhs =
                let comparee = comparef g tcref tycon (thisv,thise) (thatobjv,thate) compe
                let comparee = if isUnitTy g ty then mkZero g m else comparee
                mkMultiLambdas m tps [[thisv];[thatobjv;compv]] (comparee,g.int_ty)
            [mkCompGenBind vspec rhs]
    if tycon.IsUnionTycon then mkCompare mkUnionCompareWithComparer
    elif tycon.IsRecordTycon || tycon.IsStructOrEnumTycon then mkCompare mkRecdCompareWithComparer
    else []    
    
let MakeBindingsForEqualityWithComparerAugmentation g (tycon:Tycon) =
    let tcref = mkLocalTyconRef tycon
    let m = tycon.Range
    let tps = tycon.Typars(tycon.Range)
    let mkStructuralEquatable hashf equalsf =
        match tycon.GeneratedHashAndEqualsWithComparerValues with
        | None -> []
        | Some (objGetHashCodeVal,withcGetHashCodeVal,withcEqualsVal) ->
            
            // build the hash rhs
            let withcGetHashCodeExpr =
                let compv,compe = mkCompGenLocal m "comp" g.mk_IEqualityComparer_ty
                let thisv,hashe = hashf g tcref tycon compe
                mkLambdas m tps [thisv;compv] (hashe,g.int_ty)
                
            // build the equals rhs
            let withcEqualsExpr =
                let _tinst,ty = mkMinimalTy g tcref
                let thisv,thise = mkThisVar g m ty
                let thatobjv,thatobje = mkCompGenLocal m "obj" g.obj_ty
                let thatv,thate = mkCompGenLocal m "that" ty  
                let compv,compe = mkCompGenLocal m "comp" g.mk_IEqualityComparer_ty
                let equalse = equalsf g tcref tycon (thisv,thise) thatobje (thatv,thate) compe
                mkMultiLambdas m tps [[thisv];[thatobjv;compv]] (equalse,g.bool_ty)


            let objGetHashCodeExpr = 
                let tinst,ty = mkMinimalTy g tcref
                
                let thisv,thise = mkThisVar g m ty  
                let unitv,_ = mkCompGenLocal m "unitArg" g.unit_ty
                let hashe = 
                    if isUnitTy g ty then mkZero g m else

                    let compe = mkILCallGetEqualityComparer g m
                    mkApps g ((exprForValRef m withcGetHashCodeVal,withcGetHashCodeVal.Type), (if isNil tinst then [] else [tinst]), [thise; compe], m)
                
                mkLambdas m tps [thisv; unitv] (hashe,g.int_ty)  
                  
            [(mkCompGenBind withcGetHashCodeVal.Deref withcGetHashCodeExpr) ; 
             (mkCompGenBind objGetHashCodeVal.Deref objGetHashCodeExpr) ; 
             (mkCompGenBind withcEqualsVal.Deref withcEqualsExpr)] 
    if tycon.IsUnionTycon then mkStructuralEquatable mkUnionHashWithComparer mkUnionEqualityWithComparer
    elif (tycon.IsRecordTycon || tycon.IsStructOrEnumTycon) then mkStructuralEquatable mkRecdHashWithComparer mkRecdEqualityWithComparer
    elif tycon.IsExceptionDecl then mkStructuralEquatable mkExnHashWithComparer mkExnEqualityWithComparer
    else []

let MakeBindingsForEqualsAugmentation g (tycon:Tycon) = 
    let tcref = mkLocalTyconRef tycon 
    let m = tycon.Range 
    let tps = tycon.Typars(m)
    let mkEquals equalsf =
      match tycon.GeneratedHashAndEqualsValues with 
      | None ->  []
      | Some (objEqualsVal,nocEqualsVal) -> 
          // this is the body of the real strongly typed implementation 
          let nocEqualsExpr = 
              let thisv,thatv,equalse = equalsf g tcref tycon 
              mkLambdas m tps [thisv;thatv] (equalse,g.bool_ty)  

          // this is the body of the override 
          let objEqualsExpr = 
            let tinst,ty = mkMinimalTy g tcref
            
            let thisv,thise = mkThisVar g m ty  
            let thatobjv,thatobje = mkCompGenLocal m "obj" g.obj_ty  
            let equalse = 
                if isUnitTy g ty then mkTrue g m else

                let thatv,thate = mkCompGenLocal m "that" ty  
                mkIsInstConditional g m ty thatobje thatv 
                    (mkApps g ((exprForValRef m nocEqualsVal,nocEqualsVal.Type), (if isNil tinst then [] else [tinst]), [thise;thate], m))
                    (mkFalse g m)
            
            mkLambdas m tps [thisv;thatobjv] (equalse,g.bool_ty)  


          [ mkCompGenBind nocEqualsVal.Deref nocEqualsExpr;
            mkCompGenBind objEqualsVal.Deref objEqualsExpr;   ] 
    if tycon.IsExceptionDecl then mkEquals mkExnEquality 
    elif tycon.IsUnionTycon then mkEquals mkUnionEquality 
    elif tycon.IsRecordTycon || tycon.IsStructOrEnumTycon then mkEquals mkRecdEquality 
    else []

let rec TypeDefinitelyHasEquality g ty = 
    if isAppTy g ty && HasFSharpAttribute g g.attrib_NoEqualityAttribute (tcrefOfAppTy g ty).Attribs then
        false
    elif isTyparTy g ty &&  (destTyparTy g ty).Constraints |> List.exists (function TyparConstraint.SupportsEquality _ -> true | _ -> false) then
        true
    else 
        match ty with 
        | SpecialEquatableHeadType g tinst -> 
            tinst |> List.forall (TypeDefinitelyHasEquality g)
        | SpecialNotEquatableHeadType g _ -> 
            false
        | _ -> 
           // The type is equatable because it has Object.Equals(...)
           isAppTy g ty &&
           let tcref,tinst = destAppTy g ty 
           // Give a good error for structural types excluded from the equality relation because of their fields
           not (TyconIsCandidateForAugmentationWithEquals g tcref.Deref && isNone tcref.GeneratedHashAndEqualsWithComparerValues) &&
           // Check the (possibly inferred) structural dependencies
           (tinst, tcref.TyparsNoRange) ||> List.lengthsEqAndForall2 (fun ty tp -> not tp.EqualityConditionalOn || TypeDefinitelyHasEquality  g ty)
